home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / tjgold.zip / INSTALL.003 / DEMDB2.PAS < prev    next >
Pascal/Delphi Source File  |  1995-05-29  |  16KB  |  481 lines
  1. {--------------------------------------------------------------------------}
  2. {                Product: TechnoJock's Turbo Toolkit GOLD                  }
  3. {                                                                          }
  4. {                     TTT GOLD - DEMO PROGRAM                        }
  5. {                                                                          }
  6. {                Copyright 1986-1995  TechnoJock Software, Inc.            }
  7. {                           All Rights Reserved                            }
  8. {                          Restricted by License                           }
  9. {--------------------------------------------------------------------------}
  10.  
  11. {Description: DEMDB2.PAS
  12.               Shows each functional part of an actual database application
  13. }
  14.  
  15. program Demdb2;
  16.  
  17. {$I GOLDFLAG.INC}
  18.  
  19. uses CRT, DOS, GoldDb, GoldFast, GoldWin, GoldTint, GoldAttr, GoldMemo,
  20.      GoldStr, Goldio, Goldio2, Goldio3, GoldDate, GoldMisc, GoldKey, GoldLink;
  21.  
  22. const FN: string[12] = 'DEMCUST';
  23.       Msg1 = ' An Example Of Browsing And Editing a Database ';
  24.       Msg2 = ' Client Profiles ';
  25.       Msg5 = ' Top of file ';
  26.       Msg6 = '^Looping to last record';
  27.       Msg7 = ' End of file ';
  28.       Msg8 = '^Looping to first record';
  29.       Msg9 = ' Deleting Record! ';
  30.       Msg10 = '^Are you sure?';
  31.       Msg11 = ' Returning to DOS ';
  32.       Msg12 = '^Have you really finished?';
  33.       Msg13 = ' About to cancel! ';
  34.       EdtBtn = '~E~dit';
  35.       AddBtn = '~A~dd';
  36.       SavBtn = '~S~ave';
  37.       CanBtn = '~C~ancel';
  38.       DelBtn = '~D~el';
  39.       QuiBtn = ' ~Q~uit ';
  40.  
  41. type UserRecord = record
  42.        ENTERED: Dates;
  43.        CLIENT: string[30];
  44.        ADDR1: string[30];
  45.        ADDR2: string[30];
  46.        CITY: string[22];
  47.        STATE: string[2];
  48.        ZIP: string[9];
  49.        COUNTRY: string[20];
  50.        PHONE: string[10];
  51.        UNITS: longint;
  52.      end;
  53.  
  54. var I, Win1, Handle,
  55.     ActiveField: integer;
  56.     UserTerminates,
  57.     Saving, Editing,
  58.     Cancelling, Adding: boolean;
  59.     RecNum, X, SavedX: longint;
  60.     LastAction: gAction;
  61.     UserRec, SavdUserRec: UserRecord;
  62.     EC, NdxFld: integer;
  63.     SavValidate: gValidate;
  64.  
  65. procedure SetScreen;
  66. {}
  67. begin
  68.    Clear(WhiteOnBlack,'░');
  69.    ClearLine(1,WhiteOnBlue);
  70.    WriteCenter(1,WhiteOnBlue,Msg1);
  71.    WriteAT(68,1,YellowOnBlack,' TTT Gold! ');
  72.    ClearLine(25,BlackOnRed);
  73.    Tint[IOLabelNorm] := LightBlueOnLightGray;
  74.    Tint[IOLabelNormHot] := LightBlueOnLightGray;
  75.    Tint[IOLabelHi] := LightBlueOnLightGray;
  76.    Tint[IOLabelHiHot] := LightBlueOnLightGray;
  77.    Tint[IOLabelOff] := LightBlueOnLightGray;
  78. end; { SetScreen }
  79.  
  80. procedure SaveUserRec;
  81. {}
  82. begin
  83.    SavdUserRec := UserRec;
  84.    SavedX := X;
  85. end; { SaveUserRec }
  86.  
  87. procedure RestoreUserRec;
  88. {}
  89. begin
  90.    UserRec := SavdUserRec;
  91.    X := SavedX;
  92. end; { RestoreUserRec }
  93.  
  94. function DataHasChanged: boolean;
  95. {}
  96. begin
  97.    DataHasChanged := Different(UserRec,SavdUserRec,sizeof(UserRec));
  98. end; { DataHasChanged }
  99.  
  100. procedure InitData;
  101. {}
  102. begin
  103.    with UserRec do
  104.    begin
  105.       Entered := TodayInJul;
  106.       Client := '';
  107.       Addr1 := '';
  108.       Addr2 := '';
  109.       City := '';
  110.       State := '';
  111.       Zip := '';
  112.       Country := '';
  113.       Phone := '';
  114.       Units := 0;
  115.    end;
  116. end; { InitData }
  117.  
  118. procedure DatabaseToScreen(RecNo:longint);
  119. {}
  120. begin
  121.    with UserRec do
  122.    begin
  123.       Entered := DbGetFldDate(RecNo,1);
  124.       Client := DbGetFldString(RecNo,2);
  125.       Addr1 := DbGetFldString(RecNo,3);
  126.       Addr2 := DbGetFldString(RecNo,4);
  127.       City := DbGetFldString(RecNo,5);
  128.       State := DbGetFldString(RecNo,6);
  129.       Zip := DbGetFldString(RecNo,7);
  130.       Country := DbGetFldString(RecNo,8);
  131.       Phone := DbGetFldString(RecNo,9);
  132.       Units := DbGetFldLong(RecNo,10);
  133.    end;
  134. end; { DatabaseToScreen }
  135.  
  136. procedure ScreenToDatabase;
  137. {}
  138. begin
  139.    with UserRec do
  140.    begin
  141.       DbSetFldDate(1,Entered);
  142.       DbSetFldString(2,Client);
  143.       DbSetFldString(3,Addr1);
  144.       DbSetFldString(4,Addr2);
  145.       DbSetFldString(5,City);
  146.       DbSetFldString(6,State);
  147.       DbSetFldString(7,Zip);
  148.       DbSetFldString(8,Country);
  149.       DbSetFldString(9,Phone);
  150.       DbSetFldInt(10,Units);
  151.    end;
  152.    if Adding then
  153.    begin
  154.       DbAddRecord;
  155.       Adding := false;
  156.    end else
  157.       DbPutRecord;
  158. end; { ScreenToRecord }
  159.  
  160. procedure BuildForm;
  161. {}
  162. begin
  163.    CreateForms(1);
  164.    ActivateForm(1);
  165.    AllowEsc(false);
  166.    SetFormWindow(10,4,70,22,7);
  167.    Win1 := FormWinNum;
  168.    WinSetTitle(Win1,Msg2);
  169.    WinSetType(Win1,WMoveNoClose);
  170.    WinSetShowNum(Win1,false);
  171.    SetMessageXY(12,25,false);
  172.    WinDisplay(Win1);
  173.    KwikAddField(1, 43,2);         { ENTERED D 8 }
  174.    KwikAddField(2, 21,4);         { CLIENT C 30 }
  175.    KwikAddField(3, 21,5);         { ADDR1 C 30 }
  176.    KwikAddField(4, 21,6);         { ADDR2 C 30 }
  177.    KwikAddField(5, 21,7);         { CITY C 22 }
  178.    KwikAddField(6, 49,7);         { STATE C 2 }
  179.    KwikAddField(7, 21,8);         { ZIP C 10 }
  180.    KwikAddField(8, 21,11);        { COUNTRY C 20}
  181.    KwikAddField(9, 21,12);        { PHONE C 10}
  182.    KwikAddField(10, 21,13);       { UNITS N 10 }
  183.    KwikAddField(11, 3,16);        { goto top }
  184.    KwikAddField(12, 9,16);        { prev }
  185.    KwikAddField(13, 14,16);       { next }
  186.    KwikAddField(14, 19,16);       { goto end }
  187.    KwikAddField(15, 25,16);       { add }
  188.    KwikAddField(16, 32,16);       { del }
  189.    KwikAddField(17, 39,16);       { edit/save }
  190.    KwikAddField(18, 47,16);       { quit/cancel }
  191.    KwikAddLastField(19, 14,2);    { Record No }
  192.    with UserRec do
  193.    begin
  194.       SpinDropDateField(1,Entered,MMDDYY,'',0,0);
  195.       StringField(2,Client,Replicate(30,'*'));
  196.       FieldRules(2,NoRules+EraseDefault,[NoChar],[NoChar]);
  197.       { turns off allowNul, turn on EraseDefault }
  198.       StringField(3,Addr1,Replicate(30,'*'));
  199.       StringField(4,Addr2,Replicate(30,'*'));
  200.       StringField(5,City,Replicate(22,'*'));
  201.       StringField(6,State,'!!');
  202.       StringField(7,Zip,'#####-####');
  203.       StringField(8,Country,Replicate(20,'*'));
  204.       StringField(9,Phone,'(###) ###-####');
  205.       SpinLongField(10,Units,10,0,0,1);
  206.    end;
  207.    ButtonField(11,'',Stop1);
  208.    ButtonField(12,'',Stop2);
  209.    ButtonField(13,'',Stop3);
  210.    ButtonField(14,'',Stop4);
  211.    ButtonField(15,AddBtn,Stop8);
  212.    ButtonField(16,DelBtn,Stop9);
  213.    ButtonField(17,EdtBtn,Stop5);
  214.    ButtonDefaultField(18,QuiBtn,escaped);
  215.    LongintField(19,RecNum,'',0,0);
  216.    FieldSetState(19,FldOff); { display only }
  217.    { define labels }
  218.    SetLabel(1,LabelLeft,LabelLeft,'Date');
  219.    SetLabel(2,LabelLeft,LabelLeft,'Clients name');
  220.    SetLabel(3,LabelLeft,LabelLeft,'Address');
  221.    SetLabel(5,LabelLeft,LabelLeft,'City, State');
  222.    SetLabel(7,LabelLeft,LabelLeft,'Zip code');
  223.    SetLabel(8,LabelLeft,LabelLeft,'Country');
  224.    SetLabel(9,LabelLeft,LabelLeft,'Phone #');
  225.    SetLabel(10,LabelLeft,LabelLeft,'Units ordered');
  226.    SetLabel(19,LabelLeft,LabelLeft,'Record No');
  227.    { define messages }
  228.    SetMessage(1,0,0,'Entry date');
  229.    SetMessage(2,0,0,'Client''s name');
  230.    SetMessage(3,0,0,'Street address');
  231.    SetMessage(4,0,0,'Post office box (etc.)');
  232.    SetMessage(5,0,0,'City');
  233.    SetMessage(6,0,0,'State');
  234.    SetMessage(7,0,0,'Zip code');
  235.    SetMessage(8,0,0,'Country');
  236.    SetMessage(9,0,0,'Telephone number');
  237.    SetMessage(10,0,0,'Number of units client has ordered');
  238.    SetMessage(11,0,0,'Go to first record in database');
  239.    SetMessage(12,0,0,'Go to previous record in database');
  240.    SetMessage(13,0,0,'Go to next record in database');
  241.    SetMessage(14,0,0,'Go to last record in database');
  242.    SetMessage(15,0,0,'Add a new record');
  243.    SetMessage(16,0,0,'Delete current record');
  244.    SetMessage(17,0,0,'Edit current record');
  245.    SetMessage(18,0,0,'Return to DOS');
  246.    { define hotkeys }
  247.    SetHK(15,286);  { Alt+A } {save button}
  248.    SetHK(16,288);  { Alt+D } {del button}
  249.    SetHK(17,274);  { Alt+E } {edit button}
  250.    SetHK(18,272);  { Alt+Q } {quit button}
  251.    for I := 1 to 10 do  { set for browse }
  252.       FieldSetState(I,FldOff);
  253. end; { BuildForm }
  254.  
  255. procedure CreateNewDataFile;
  256. {could be built on the fly via I/O form}
  257. var EValue: integer;
  258. begin
  259.    EValue := 0;
  260.    inc(EValue,DbAddDbfField('DATE','D',8,0));       { DATE  D  8 }
  261.    inc(EValue,DbAddDbfField('CLIENT','C',30,0));    { LAST  C 15 }
  262.    inc(EValue,DbAddDbfField('ADDR1','C',30,0));     { ADDR1 C 30 }
  263.    inc(EValue,DbAddDbfField('ADDR2','C',30,0));     { ADDR2 C 30 }
  264.    inc(EValue,DbAddDbfField('CITY','C',22,0));      { CITY  C 22 }
  265.    inc(EValue,DbAddDbfField('STATE','C',2,0));      { STATE C  2 }
  266.    inc(EValue,DbAddDbfField('ZIP','C',10,0));       { ZIP   C 10 }
  267.    inc(EValue,DbAddDbfField('COUNTRY','C',20,0));   { COUNTRY C 20 }
  268.    inc(EValue,DbAddDbfField('PHONE','C',10,0));     { PHONE C 10 }
  269.    inc(EValue,DbAddDbfField('UNITS','N',10,0));     { UNITS C 14 }
  270.    inc(EValue,DbBuildDataFile(FN,1));
  271.    if EValue <> 0 then
  272.    begin
  273.       PromptOK(' File Error ','Unable to create data file!');
  274.       Halt;
  275.    end;
  276. end; { CreateNewDataFile }
  277.  
  278. procedure PreSetFields;
  279. {}
  280. begin
  281.    if DbGetNumRecs = 0 then
  282.    begin
  283.       for I := 11 to 14 do { turn off VCR buttons }
  284.          FieldSetState(I,FldOff);
  285.       FieldSetState(17,FldOff); { turn off edit button }
  286.       FieldSetState(16,FldOff); { turn off del button }
  287.       ActiveField := 15;  {add button}
  288.    end else
  289.       ActiveField := 13;
  290. end; { PreSetFields }
  291.  
  292. procedure CompleteStop6or7;
  293. {}
  294. begin
  295.    for I := 1 to 10 do          { fields }
  296.       FieldSetState(I,FldOff);
  297.    for I := 11 to 18 do
  298.       FieldSetState(I,FldOn);
  299.    ButtonChangeSettings(17,EdtBtn,Stop5);
  300.    SetMessage(17,0,0,'Edit current record');
  301.    SetHK(17,274);  { Alt+E } {edit button}
  302.    ButtonChangeSettings(18,QuiBtn,Escaped);
  303.    SetMessage(18,0,0,'Return to DOS');
  304.    SetHK(18,272);  { Alt+Q } {quit button}
  305.    ActiveField := 13;  { next }
  306. end; { CompleteStop6or7 }
  307.  
  308. procedure SetValidation;
  309. {}
  310. begin
  311.    SavValidate := IOVars.DefaultValidate;
  312.    IOVars.DefaultValidate := ValidateAtEnd;
  313. end; { SetValidation }
  314.  
  315. procedure RestoreValidation;
  316. {}
  317. begin
  318.    IOVars.DefaultValidate := SavValidate;
  319. end; { RestoreValidation }
  320.  
  321. procedure InitVars;
  322. {}
  323. begin
  324.    NdxFld := 2;
  325.    EC := 0;
  326.    Adding := false;
  327.    Saving := false;
  328.    Editing := false;
  329.    Cancelling := false;
  330. end; { InitVars }
  331.  
  332. begin { main }
  333. {$IFOPT D+}
  334.    HeapRecord;
  335. {$ENDIF}
  336.    if not DBFExist(FN) then
  337.       CreateNewDataFile;
  338.    InitVars;
  339.    Handle := DbOpenDataSet(FN); {extremely important assignment}
  340.    if Handle <> 0 then
  341.    begin
  342.       if DbIndexedField = 0 then
  343.       begin
  344.         { SetShowNdxProgress(Bleep);}
  345.          Box3D(10,5,70,10,BlackOnCyan,WhiteOnCyan,1);
  346.          WriteAT(20,6,BlueOnCyan,'Building New Index...');
  347.          EC := NdxBuildNew(NdxFld);
  348.          if EC <> 0 then
  349.          begin
  350.             PromptOK(' INDEX ERROR ','^Index is missing!|^Error Code - '+IntToStr(EC));
  351.             halt;
  352.          end;
  353.       end;
  354.       Tint[IOWinTitle] := WhiteOnRed;
  355.       SetValidation;
  356.       SetScreen;
  357.       BuildForm;
  358.       MouseShow(true);
  359.       PreSetFields;
  360.       UserTerminates := false;
  361.       DbSetFullStrings(false);
  362.       InitData;
  363.       X := NdxGotoFirst;
  364.       repeat
  365.          RecNum := X;
  366.          if ((DbGetNumRecs > 0) and (X > 0)) and
  367.             (not Saving) and
  368.             (not Editing) and
  369.             (not Cancelling) then
  370.             DatabaseToScreen(X);
  371.          DisplayForm;
  372.          LastAction := EditForm(ActiveField);
  373.          ActiveField := FieldWithFocus;
  374.          Editing := false;
  375.          Saving := false;
  376.          Cancelling := false;
  377.          case LastAction of
  378.             Stop1: begin
  379.                       X := NdxGotoFirst;
  380.                       ActiveField := 13;  { next }
  381.                    end;
  382.             Stop2: begin
  383.                       X := NdxGotoPrev;
  384.                       if X = 0 then
  385.                       begin
  386.                          X := NdxGotoLast;
  387.                          PromptOK(Msg5,Msg6)
  388.                       end;
  389.                    end;
  390.             Stop3: begin
  391.                       X := NdxGotoNext;
  392.                       if X = 0 then
  393.                       begin
  394.                          X := NdxGotoFirst;
  395.                          PromptOK(Msg7,Msg8);
  396.                       end;
  397.                    end;
  398.             Stop4: begin
  399.                       X := NdxGotoLast;
  400.                       ActiveField := 12;  { prev }
  401.                    end;
  402.             Stop8,         { add  }
  403.             Stop5: begin   { edit }
  404.                       SaveUserRec;
  405.                       if (LastAction = Stop8) then
  406.                       begin
  407.                          Adding := true;
  408.                          InitData;
  409.                          X := 0; { prevents redisplaying previous data }
  410.                          FieldSetState(15,FldOff); { add }
  411.                          FieldSetState(17,FldOn);  { edit/save }
  412.                       end
  413.                       else Editing := true;
  414.  
  415.                       for I := 1 to 10 do          { fields }
  416.                          FieldSetState(I,FldOn);
  417.                       for I := 11 to 14 do         { vcr }
  418.                          FieldSetState(I,FldOff);
  419.                       FieldSetState(15,FldOff);    { add }
  420.                       FieldSetState(16,FldOff);    { del }
  421.                       ButtonChangeSettings(17,SavBtn,Stop6);
  422.                       SetMessage(17,0,0,'Saves edited information');
  423.                       SetHK(17,287);
  424.                       ButtonChangeSettings(18,CanBtn,Cancel1);
  425.                       SetMessage(18,0,0,'Cancels current operation');
  426.                       SetHK(18,302);
  427.                       ActiveField := 2;
  428.                    end;
  429.             Stop6: begin   { save }
  430.                       if DataHasChanged then
  431.                       begin
  432.                          ScreenToDatabase;
  433.                          Saving := true;
  434.                       end;
  435.                       CompleteStop6or7;
  436.                    end;
  437.           Cancel1: begin   { cancel }
  438.                       Cancelling := true;
  439.                       if PromptYesNo(Msg13,Msg10) = 1 then
  440.                       begin
  441.                          Adding := false;
  442.                          if DbGetNumRecs > 0 then
  443.                             RestoreUserRec;
  444.                          CompleteStop6or7;
  445.                       end
  446.                    end;
  447.             Stop9: begin   { delete }
  448.                       for I := 11 to 15 do
  449.                          FieldSetState(I,FldOff);
  450.                       FieldSetState(17,FldOff);
  451.                       if PromptYesNo(Msg9,Msg10) = 1 then
  452.                       begin
  453.                          DbDeleteRecord(X);
  454.                          X := NdxGotoNext;
  455.                          if X = 0 then
  456.                             X := NdxGotoFirst;
  457.                       end;
  458.                       for I := 11 to 15 do
  459.                          FieldSetState(I,FldOn);
  460.                       FieldSetState(17,FldOn);
  461.                       ActiveField := 13;
  462.                    end;
  463.           Escaped: begin
  464.                       if PromptYesNo(Msg11,Msg12) = 1 then
  465.                          UserTerminates := true;
  466.                    end;
  467.          end;  { case }
  468.       until UserTerminates;
  469.       DisposeFields;
  470.       DisposeForms;
  471.       MouseShow(false);
  472.       DbCloseAllDatabases;
  473.       RestoreValidation;
  474.    end else
  475.       PromptOK(' DATA ERROR ','Unable to open '+FN+' or one of its related files.');
  476.    Clear(LightGrayOnBlack,' ');
  477. {$IFOPT D+}
  478.    HeapCheck;
  479. {$ENDIF}
  480. end.
  481.